home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue28 / vcard / VCARD.ZIP / msvcls.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-10-13  |  25.1 KB  |  1,042 lines
  1. unit Msvcls;
  2.  
  3. interface
  4.  
  5. uses Classes, SysUtils;
  6.  
  7. type
  8.   TmsAddressType = (msaDomestic, msaInternational, msaPostal, msaParcel,
  9.                     msaHome, msaWork);
  10.   TmsAddressAttributes = set of TmsAddressType;
  11.   TmsPhoneType = (mstPreferred, mstWork, mstHome, mstVoice, mstFax,
  12.                   mstMessaging, mstCellular, mstPager, mstBBS, mstModem,
  13.                   mstCar, mstISDN, mstVideo);
  14.   TmsPhoneAttributes = set of TmsPhoneType;
  15.   TmsEmailType = (mseDefault, mseAOL, mseAppleLink, mseATTMail, mseCompuserve,
  16.                   mseeWorld, mseInternet, mseIBM, mseMCI, msePowerShare,
  17.                   mseProdigy, mseTelex, mseX400);
  18.  
  19. const
  20.   AddressStrings : array[TmsAddressType] of string[6] =
  21.                   ('DOM','INTL','POSTAL','PARCEL','HOME','WORK');
  22.   PhoneStrings : array[TmsPhoneType] of string[5] =
  23.                   ('PREF','WORK','HOME','VOICE','FAX','MSG','CELL',
  24.                    'PAGER','BBS','MODEM','CAR','ISDN','VIDEO');
  25.   EmailStrings : array[TmsEmailType] of string[10] =
  26.                   ('','AOL','APPLELINK','ATTMAIL','CIS','EWORLD','INTERNET',
  27.                    'IBMMAIL','MCIMAIL','POWERSHARE','PRODIGY','TLX','X400');
  28.  
  29. type
  30.  
  31.   TmsNameRec = class(TPersistent)
  32.   private
  33.     FFamilyName : string;
  34.     FGivenName : string;
  35.     FAdditionalNames : string;
  36.     FPrefix : string;
  37.     FSuffix : string;
  38.   public
  39.     procedure Assign(Value : TPersistent); override;
  40.     procedure Clear;
  41.     procedure SaveToStrings(Strings : TStrings);
  42.     procedure LoadFromStrings(Strings : TStrings);
  43.   published
  44.     property FamilyName : string read FFamilyName write FFamilyName;
  45.     property GivenName : string read FGivenName write FGivenName;
  46.     property AdditionalNames : string read FAdditionalNames write FAdditionalNames;
  47.     property Prefix : string read FPrefix write FPrefix;
  48.     property Suffix : string read FSuffix write FSuffix;
  49.   end;
  50.  
  51.   TmsIdentification = class(TPersistent)
  52.   private
  53.     FName : TmsNameRec;
  54.     FFormattedName : string;
  55.     procedure SetName(Value : TmsNameRec);
  56.   public
  57.     constructor Create;
  58.     destructor Destroy; override;
  59.     procedure Assign(Value : TPersistent); override;
  60.     procedure Clear;
  61.     procedure SaveToStrings(Strings : TStrings);
  62.     procedure LoadFromStrings(Strings : TStrings);
  63.   published
  64.     property Name : TmsNameRec read FName write SetName;
  65.     property FormattedName : string read FFormattedName write FFormattedName;
  66.   end;
  67.  
  68.   TmsAddressRec = class(TPersistent)
  69.   private
  70.     FAttributes : TmsAddressAttributes;
  71.     FPOAddress : string;
  72.     FExtendedAddress : string;
  73.     FStreet : string;
  74.     FLocality : string;
  75.     FRegion : string;
  76.     FPostalCode : string;
  77.     FCountry : string;
  78.   protected
  79.     procedure FillAttributes(Strings : TStrings);
  80.   public
  81.     procedure Assign(Value : TPersistent); override;
  82.     procedure Clear;
  83.     procedure SaveToStrings(Strings : TStrings);
  84.     procedure LoadFromStrings(Strings : TStrings);
  85.   published
  86.     property Attributes : TmsAddressAttributes read FAttributes write FAttributes;
  87.     property POAddress : string read FPOAddress write FPOAddress;
  88.     property ExtendedAddress : string read FExtendedAddress write FExtendedAddress;
  89.     property Street : string read FStreet write FStreet;
  90.     property Locality : string read FLocality write FLocality;
  91.     property Region : string read FRegion write FRegion;
  92.     property PostalCode : string read FPostalCode write FPostalCode;
  93.     property Country : string read FCountry write FCountry;
  94.   end;
  95.  
  96.   TmsDeliveryInfo = class(TPersistent)
  97.   private
  98.     FAddress1 : TmsAddressRec;
  99.     FAddress2 : TmsAddressRec;
  100.     procedure SetAddress1(Value : TmsAddressRec);
  101.     procedure SetAddress2(Value : TmsAddressRec);
  102.   public
  103.     constructor Create;
  104.     destructor Destroy; override;
  105.     procedure Assign(Value : TPersistent); override;
  106.     procedure Clear;
  107.     procedure SaveToStrings(Strings : TStrings);
  108.     procedure LoadFromStrings(Strings : TStrings);
  109.   published
  110.     property Address1 : TmsAddressRec read FAddress1 write SetAddress1;
  111.     property Address2 : TmsAddressRec read FAddress2 write SetAddress2;
  112.   end;
  113.  
  114.   TmsPhoneRec = class(TPersistent)
  115.   private
  116.     FAttributes : TmsPhoneAttributes;
  117.     FNumber : string;
  118.   protected
  119.     procedure FillAttributes(Strings : TStrings);
  120.   public
  121.     procedure Assign(Value : TPersistent); override;
  122.     procedure Clear;
  123.     procedure SaveToStrings(Strings : TStrings);
  124.     procedure LoadFromStrings(Strings : TStrings);
  125.   published
  126.     property Attributes : TmsPhoneAttributes read FAttributes write FAttributes;
  127.     property Number : string read FNumber write FNumber;
  128.   end;
  129.  
  130.   TmsEmailRec = class(TPersistent)
  131.   private
  132.     FEmailType : TmsEmailType;
  133.     FAddress : string;
  134.   protected
  135.     procedure FillEmaiLType(Strings : TStrings);
  136.   public
  137.     procedure Assign(Value : TPersistent); override;
  138.     procedure Clear;
  139.     procedure SaveToStrings(Strings : TStrings);
  140.     procedure LoadFromStrings(Strings : TStrings);
  141.   published
  142.     property EmailType : TmsEmailType read FEmailType write FEmailType;
  143.     property Address : string read FAddress write FAddress;
  144.   end;
  145.  
  146.   TmsTelecomInfo = class(TPersistent)
  147.   private
  148.     FPhone1 : TmsPhoneRec;
  149.     FPhone2 : TmsPhoneRec;
  150.     FPhone3 : TmsPhoneRec;
  151.     FEmail1 : TmsEmailRec;
  152.     FEmail2 : TmsEmailRec;
  153.     procedure SetPhone1(Value : TmsPhoneRec);
  154.     procedure SetPhone2(Value : TmsPhoneRec);
  155.     procedure SetPhone3(Value : TmsPhoneRec);
  156.     procedure SetEmail1(Value : TmsEmailRec);
  157.     procedure SetEmail2(Value : TmsEmailRec);
  158.   public
  159.     constructor Create;
  160.     destructor Destroy; override;
  161.     procedure Assign(Value : TPersistent); override;
  162.     procedure Clear;
  163.     procedure SaveToStrings(Strings : TStrings);
  164.     procedure LoadFromStrings(Strings : TStrings);
  165.   published
  166.     property Phone1 : TmsPhoneRec read FPhone1 write SetPhone1;
  167.     property Phone2 : TmsPhoneRec read FPhone2 write SetPhone2;
  168.     property Phone3 : TmsPhoneRec read FPhone3 write SetPhone3;
  169.     property Email1 : TmsEmailRec read FEmail1 write SetEmail1;
  170.     property Email2 : TmsEmailRec read FEmail2 write SetEmail2;
  171.   end;
  172.  
  173.   TmsCompanyRec = class(TPersistent)
  174.   private
  175.     FName : string;
  176.     FAUnit : string;
  177.   public
  178.     procedure Assign(Value : TPersistent); override;
  179.     procedure Clear;
  180.     procedure SaveToStrings(Strings : TStrings);
  181.     procedure LoadFromStrings(Strings : TStrings);
  182.   published
  183.     property Name : string read FName write FName;
  184.     property AUnit : string read FAUnit write FAUnit;
  185.   end;
  186.  
  187.   TmsBusinessInfo = class(TPersistent)
  188.   private
  189.     FTitle : string;
  190.     FRole : string;
  191.     FCompany : TmsCompanyRec;
  192.     procedure SetCompany(Value : TmsCompanyRec);
  193.   public
  194.     constructor Create;
  195.     destructor Destroy; override;
  196.     procedure Assign(Value : TPersistent); override;
  197.     procedure Clear;
  198.     procedure SaveToStrings(Strings : TStrings);
  199.     procedure LoadFromStrings(Strings : TStrings);
  200.   published
  201.     property Title : string read FTitle write FTitle;
  202.     property Role : string read FRole write FRole;
  203.     property Company : TmsCompanyRec read FCompany write SetCompany;
  204.   end;
  205.  
  206.   TmsExplanatoryInfo = class(TPersistent)
  207.   private
  208.     FComment : TStrings;
  209.     FURL1 : string;
  210.     FURL2 : string;
  211.     procedure SetComment(Value : TStrings);
  212.   public
  213.     constructor Create;
  214.     destructor Destroy; override;
  215.     procedure Assign(Value : TPersistent); override;
  216.     procedure Clear;
  217.     procedure SaveToStrings(Strings : TStrings);
  218.     procedure LoadFromStrings(Strings : TStrings);
  219.   published
  220.     property Comment : TStrings read FComment write SetComment;
  221.     property URL1 : string read FURL1 write FURL1;
  222.     property URL2 : string read FURL2 write FURL2;
  223.   end;
  224.  
  225. implementation
  226.  
  227. type
  228.   TmsPropertyParser = class
  229.   private
  230.     FLines : TStrings;
  231.     FNames : TStrings;
  232.     FValues : TStrings;
  233.     FPropertyName : string;
  234.   protected
  235.     Buf : PChar;
  236.     function IndexOfName : Integer;
  237.     procedure PropertyToBuffer;
  238.     procedure FillNamesAndValues;
  239.     procedure Buf2Strings(Buf : PChar; Strings : TStrings);
  240.   public
  241.     constructor Create;
  242.     destructor Destroy; override;
  243.     procedure Process;
  244.     property Lines : TStrings read FLines write FLines;
  245.     property Names : TStrings read FNames;
  246.     property Values : TStrings read FValues;
  247.     property PropertyName : string read FPropertyName write FPropertyName;
  248.   end;
  249.  
  250. constructor TmsPropertyParser.Create;
  251. begin
  252.   inherited Create;
  253.   FNames:=TStringList.Create;
  254.   FValues:=TStringList.Create;
  255.   Buf:=StrAlloc($2000);
  256. end;
  257.  
  258. destructor TmsPropertyParser.Destroy;
  259. begin
  260.   StrDispose(Buf);
  261.   FValues.Free;
  262.   FNames.Free;
  263.   inherited Destroy;
  264. end;
  265.  
  266. function TmsPropertyParser.IndexOfName : Integer;
  267. var
  268.   i : Integer;
  269.   Found : boolean;
  270.   s, Name : string;
  271. begin
  272.   Result:=-1;
  273.   if FLines.Count=0 then Exit;
  274.   Name:=UpperCase(FPropertyName);
  275.   if Name[Length(Name)]=':' then
  276.     Delete(Name,Length(Name),1);
  277.   i:=0;
  278.   repeat
  279.     s:=UpperCase(Lines[i]);
  280.     Found:=(Length(s)>Length(Name)) and (Copy(s,1,Length(Name))=Name) and
  281.       (s[Length(Name)+1] in [':',';']);
  282.     Inc(i);
  283.   until Found or (i=Lines.Count);
  284.   if Found then
  285.     Result:=i-1;
  286. end;
  287.  
  288. procedure TmsPropertyParser.PropertyToBuffer;
  289. var
  290.   i : Integer;
  291.   s : string;
  292. begin
  293.   FillChar(Buf^,StrBufSize(Buf),0);
  294.   i:=IndexOfName;
  295.   if i>-1 then
  296.   begin
  297.     repeat
  298. {$IFDEF WIN32}
  299.       s:=Trim(FLines[i]);
  300. {$ENDIF}
  301.       if s<>'' then
  302.       begin
  303.         if StrLen(Buf)<>0 then
  304.           s:=Concat(' ',s);
  305.         s:=Concat(s,#00);
  306.         StrCat(Buf,@s[1]);
  307.       end;
  308.       FLines.Delete(i);
  309.     until (i=FLines.Count) or
  310.       ((Copy(FLines[i],1,1)<>' ') and (Copy(FLines[i],1,1)<>^I));
  311.   end;
  312. end;
  313.  
  314. procedure TmsPropertyParser.Buf2Strings(Buf : PChar; Strings : TStrings);
  315. var
  316.   p, TempBuf : PChar;
  317. begin
  318.   Strings.Clear;
  319.   TempBuf:=StrAlloc($1000);
  320.   try
  321.     repeat
  322.       p:=StrPos(Buf,';');
  323.       if p<>nil then
  324.       begin
  325.         StrLCopy(TempBuf,Buf,p-Buf);
  326.         Strings.Add(StrPas(TempBuf));
  327.         Buf:=p+1;
  328.       end
  329.       else
  330.         Strings.Add(StrPas(Buf));
  331.     until p=nil;
  332.   finally
  333.     StrDispose(TempBuf);
  334.   end;
  335. end;
  336.  
  337. procedure TmsPropertyParser.FillNamesAndValues;
  338. var
  339.   NamesStr, ValuesStr, p : PChar;
  340. begin
  341.   if StrLen(Buf)>0 then
  342.   begin
  343.     ValuesStr:=StrAlloc($1000);
  344.     try
  345.       NamesStr:=StrAlloc($1000);
  346.       try
  347.         p:=StrPos(Buf,':');
  348.         if p<>nil then
  349.         begin
  350.           StrLCopy(NamesStr,Buf,p-Buf);
  351.           StrCopy(ValuesStr,p+1);
  352.           Buf2Strings(NamesStr,Names);
  353.           Buf2Strings(ValuesStr,Values);
  354.         end;
  355.       finally
  356.         StrDispose(NamesStr);
  357.       end;
  358.     finally
  359.       StrDispose(ValuesStr);
  360.     end;
  361.   end;
  362. end;
  363.  
  364. procedure TmsPropertyParser.Process;
  365. begin
  366.   PropertyToBuffer;
  367.   FillNamesAndValues;
  368. end;
  369.  
  370. {TmsNameRec}
  371. procedure TmsNameRec.Assign(Value : TPersistent);
  372. begin
  373.   if Value is TmsNameRec then
  374.   begin
  375.     FFamilyName:=(Value as TmsNameRec).FamilyName;
  376.     FGivenName:=(Value as TmsNameRec).GivenName;
  377.     FAdditionalNames:=(Value as TmsNameRec).AdditionalNames;
  378.     FPrefix:=(Value as TmsNameRec).Prefix;
  379.     FSuffix:=(Value as TmsNameRec).Suffix;
  380.   end
  381.   else
  382.     inherited Assign(Value);
  383. end;
  384.  
  385. procedure TmsNameRec.Clear;
  386. begin
  387.   FFamilyName:='';
  388.   FGivenName:='';
  389.   FAdditionalNames:='';
  390.   FPrefix:='';
  391.   FSuffix:='';
  392. end;
  393.  
  394. procedure TmsNameRec.SaveToStrings(Strings : TStrings);
  395. var
  396.   s : string;
  397. begin
  398.   if Concat(FFamilyName,FGivenName,FAdditionalNames,FPrefix,FSuffix)<>'' then
  399.   begin
  400.     s:='N:';
  401.     s:=Concat(s,FamilyName,';');
  402.     s:=Concat(s,FGivenName,';');
  403.     s:=Concat(s,FAdditionalNames,';');
  404.     s:=Concat(s,FPrefix,';');
  405.     s:=Concat(s,FSuffix);
  406.     Strings.Add(s);
  407.   end;
  408. end;
  409.  
  410. procedure TmsNameRec.LoadFromStrings(Strings : TStrings);
  411. begin
  412.   Clear;
  413.   with TmsPropertyParser.Create do
  414.   try
  415.     Lines:=Strings;
  416.     PropertyName:='N';
  417.     Process;
  418.     if Values.Count>4 then
  419.       FSuffix:=Values[4];
  420.     if Values.Count>3 then
  421.       FPrefix:=Values[3];
  422.     if Values.Count>2 then
  423.       FAdditionalNames:=Values[2];
  424.     if Values.Count>1 then
  425.       FGivenName:=Values[1];
  426.     if Values.Count>0 then
  427.       FFamilyName:=Values[0];
  428.   finally
  429.     Free;
  430.   end;
  431. end;
  432.  
  433. {TmsIdentification}
  434. constructor TmsIdentification.Create;
  435. begin
  436.   inherited Create;
  437.   FName:=TmsNameRec.Create;
  438. end;
  439.  
  440. destructor TmsIdentification.Destroy;
  441. begin
  442.   FName.Free;
  443.   inherited Destroy;
  444. end;
  445.  
  446. procedure TmsIdentification.SetName(Value : TmsNameRec);
  447. begin
  448.   FName.Assign(Value);
  449. end;
  450.  
  451. procedure TmsIdentification.Assign(Value : TPersistent);
  452. begin
  453.   if Value is TmsIdentification then
  454.   begin
  455.     FName.Assign((Value as TmsIdentification).Name);
  456.     FFormattedName:=(Value as TmsIdentification).FormattedName;
  457.   end
  458.   else inherited Assign(Value);
  459. end;
  460.  
  461. procedure TmsIdentification.Clear;
  462. begin
  463.   FName.Clear;
  464.   FFormattedName:='';
  465. end;
  466.  
  467. procedure TmsIdentification.SaveToStrings(Strings : TStrings);
  468. begin
  469.   if FFormattedName<>'' then
  470.     Strings.Add(Concat('FN:',FFormattedName));
  471.   FName.SaveToStrings(Strings);
  472. end;
  473.  
  474. procedure TmsIdentification.LoadFromStrings(Strings : TStrings);
  475. begin
  476.   Clear;
  477.   FName.LoadFromStrings(Strings);
  478.   with TmsPropertyParser.Create do
  479.   try
  480.     Lines:=Strings;
  481.     PropertyName:='FN';
  482.     Process;
  483.     if Values.Count>0 then
  484.       FFormattedName:=Values[0];
  485.   finally
  486.     Free;
  487.   end;
  488. end;
  489.  
  490. {TmsAddressRec}
  491. procedure TmsAddressRec.Assign(Value : TPersistent);
  492. begin
  493.   if Value is TmsAddressRec then
  494.   begin
  495.     FAttributes:=(Value as TmsAddressRec).Attributes;
  496.     FPOAddress:=(Value as TmsAddressRec).POAddress;
  497.     FExtendedAddress:=(Value as TmsAddressRec).ExtendedAddress;
  498.     FStreet:=(Value as TmsAddressRec).Street;
  499.     FLocality:=(Value as TmsAddressRec).Locality;
  500.     FRegion:=(Value as TmsAddressRec).Region;
  501.     FPostalCode:=(Value as TmsAddressRec).PostalCode;
  502.     FCountry:=(Value as TmsAddressRec).Country;
  503.   end
  504.   else
  505.     inherited Assign(Value);
  506. end;
  507.  
  508. procedure TmsAddressRec.Clear;
  509. begin
  510.   FAttributes:=[];
  511.   FPOAddress:='';
  512.   FExtendedAddress:='';
  513.   FStreet:='';
  514.   FLocality:='';
  515.   FRegion:='';
  516.   FPostalCode:='';
  517.   FCountry:='';
  518. end;
  519.  
  520. procedure TmsAddressRec.SaveToStrings(Strings : TStrings);
  521. var
  522.   s : string;
  523.   i : TmsAddressType;
  524. begin
  525.   if Concat(FPOAddress,FExtendedAddress,FStreet,FLocality,FRegion,FPostalCode,
  526.             FCountry)<>'' then
  527.   begin
  528.     s:='ADR';
  529.     for i:=msaDomestic to msaWork do
  530.     if i in Attributes then
  531.       s:=Concat(s,';',AddressStrings[i]);
  532.     s:=Concat(s,':');
  533.     s:=Concat(s,FPOAddress,';');
  534.     s:=Concat(s,FExtendedAddress,';');
  535.     s:=Concat(s,FStreet,';');
  536.     s:=Concat(s,FLocality,';');
  537.     s:=Concat(s,FRegion,';');
  538.     s:=Concat(s,FPostalCode,';');
  539.     s:=Concat(s,FCountry);
  540.     Strings.Add(s);
  541.   end;
  542. end;
  543.  
  544. procedure TmsAddressRec.FillAttributes(Strings : TStrings);
  545. var
  546.   i : TmsAddressType;
  547. begin
  548.   if Strings.Count>0 then
  549.   begin
  550.     for i:=msaDomestic to msaWork do
  551.     begin
  552.       if Strings.IndexOf(AddressStrings[i])>-1 then
  553.         Include(FAttributes,i);
  554.     end;
  555.   end;
  556. end;
  557.  
  558. procedure TmsAddressRec.LoadFromStrings(Strings : TStrings);
  559. begin
  560.   Clear;
  561.   with TmsPropertyParser.Create do
  562.   try
  563.     Lines:=Strings;
  564.     PropertyName:='ADR';
  565.     Process;
  566.     if Values.Count>6 then
  567.       FCountry:=Values[6];
  568.     if Values.Count>5 then
  569.       FPostalCode:=Values[5];
  570.     if Values.Count>4 then
  571.       FRegion:=Values[4];
  572.     if Values.Count>3 then
  573.       FLocality:=Values[3];
  574.     if Values.Count>2 then
  575.       FStreet:=Values[2];
  576.     if Values.Count>1 then
  577.       FExtendedAddress:=Values[1];
  578.     if Values.Count>0 then
  579.       FPOAddress:=Values[0];
  580.     FillAttributes(Names);
  581.   finally
  582.     Free;
  583.   end;
  584. end;
  585.  
  586. {TmsDeliveryInfo}
  587. constructor TmsDeliveryInfo.Create;
  588. begin
  589.   inherited Create;
  590.   FAddress1:=TmsAddressRec.Create;
  591.   FAddress2:=TmsAddressRec.Create;
  592. end;
  593.  
  594. destructor TmsDeliveryInfo.Destroy;
  595. begin
  596.   FAddress2.Free;
  597.   FAddress1.Free;
  598.   inherited Destroy;
  599. end;
  600.  
  601. procedure TmsDeliveryInfo.SetAddress1(Value : TmsAddressRec);
  602. begin
  603.   FAddress1.Assign(Value);
  604. end;
  605.  
  606. procedure TmsDeliveryInfo.SetAddress2(Value : TmsAddressRec);
  607. begin
  608.   FAddress2.Assign(Value);
  609. end;
  610.  
  611. procedure TmsDeliveryInfo.Assign(Value : TPersistent);
  612. begin
  613.   if Value is TmsDeliveryInfo then
  614.   begin
  615.     FAddress1.Assign((Value as TmsDeliveryInfo).Address1);
  616.     FAddress2.Assign((Value as TmsDeliveryInfo).Address2);
  617.   end
  618.   else
  619.     inherited Assign(Value);
  620. end;
  621.  
  622. procedure TmsDeliveryInfo.Clear;
  623. begin
  624.   FAddress1.Clear;
  625.   FAddress2.Clear;
  626. end;
  627.  
  628. procedure TmsDeliveryInfo.SaveToStrings(Strings : TStrings);
  629. begin
  630.   FAddress1.SaveToStrings(Strings);
  631.   FAddress2.SaveToStrings(Strings);
  632. end;
  633.  
  634. procedure TmsDeliveryInfo.LoadFromStrings(Strings : TStrings);
  635. begin
  636.   Clear;
  637.   FAddress1.LoadFromStrings(Strings);
  638.   FAddress2.LoadFromStrings(Strings);
  639. end;
  640.  
  641. {TmsPhoneRec}
  642. procedure TmsPhoneRec.Assign(Value : TPersistent);
  643. begin
  644.   if Value is TmsPhoneRec then
  645.   begin
  646.     FAttributes:=(Value as TmsPhoneRec).Attributes;
  647.     FNumber:=(Value as TmsPhoneRec).Number;
  648.   end
  649.   else
  650.     inherited Assign(Value);
  651. end;
  652.  
  653. procedure TmsPhoneRec.Clear;
  654. begin
  655.   FAttributes:=[];
  656.   FNumber:='';
  657. end;
  658.  
  659. procedure TmsPhoneRec.SaveToStrings(Strings : TStrings);
  660. var
  661.   i : TmsPhoneType;
  662.   s : string;
  663. begin
  664.   if FNumber<>'' then
  665.   begin
  666.     s:='TEL';
  667.     for i:=mstPreferred to mstVideo do
  668.     if i in FAttributes then
  669.       s:=Concat(s,';',PhoneStrings[i]);
  670.     s:=Concat(s,':',FNumber);
  671.     Strings.Add(s);
  672.   end;
  673. end;
  674.  
  675. procedure TmsPhoneRec.FillAttributes(Strings : TStrings);
  676. var
  677.   i : TmsPhoneType;
  678. begin
  679.   if Strings.Count>0 then
  680.   begin
  681.     for i:=mstPreferred to mstVideo do
  682.     begin
  683.       if Strings.IndexOf(PhoneStrings[i])>-1 then
  684.         Include(FAttributes,i);
  685.     end;
  686.   end;
  687. end;
  688.  
  689. procedure TmsPhoneRec.LoadFromStrings(Strings : TStrings);
  690. begin
  691.   with TmsPropertyParser.Create do
  692.   try
  693.     Lines:=Strings;
  694.     PropertyName:='TEL';
  695.     Process;
  696.     if Values.Count>0 then
  697.       FNumber:=Values[0];
  698.     FillAttributes(Names);
  699.   finally
  700.     Free;
  701.   end;
  702. end;
  703.  
  704. {TmsEmailRec}
  705. procedure TmsEmailRec.Assign(Value : TPersistent);
  706. begin
  707.   if Value is TmsEmailRec then
  708.   begin
  709.     FEmailType:=(Value as TmsEmailRec).EmailType;
  710.     FAddress:=(Value as TmsEmailRec).Address;
  711.   end
  712.   else
  713.     inherited Assign(Value);
  714. end;
  715.  
  716. procedure TmsEmailRec.Clear;
  717. begin
  718.   FEmailType:=mseDefault;
  719.   FAddress:='';
  720. end;
  721.  
  722. procedure TmsEmailRec.SaveToStrings(Strings : TStrings);
  723. var
  724.   s : string;
  725. begin
  726.   if FAddress<>'' then
  727.   begin
  728.     s:='EMAIL';
  729.     s:=Concat(s,';',EmailStrings[FEmailType],':',FAddress);
  730.     Strings.Add(s);
  731.   end;
  732. end;
  733.  
  734. procedure TmsEmailRec.FillEmaiLType(Strings : TStrings);
  735. var
  736.   i : TmsEmailType;
  737. begin
  738.   if Strings.Count>0 then
  739.   begin
  740.     for i:=mseDefault to mseX400 do
  741.     begin
  742.       if Strings.IndexOf(EmailStrings[i])>0 then
  743.         FEmailType:=i;
  744.     end;
  745.   end;
  746. end;
  747.  
  748. procedure TmsEmailRec.LoadFromStrings(Strings : TStrings);
  749. begin
  750.   with TmsPropertyParser.Create do
  751.   try
  752.     Lines:=Strings;
  753.     PropertyName:='EMAIL';
  754.     Process;
  755.     if Values.Count>0 then
  756.       FAddress:=Values[0];
  757.     FillEmailType(Names);
  758.   finally
  759.     Free;
  760.   end;
  761. end;
  762.  
  763. {TmsTelecomInfo}
  764. constructor TmsTelecomInfo.Create;
  765. begin
  766.   inherited Create;
  767.   FPhone1:=TmsPhoneRec.Create;
  768.   FPhone2:=TmsPhoneRec.Create;
  769.   FPhone3:=TmsPhoneRec.Create;
  770.   FEmail1:=TmsEmailRec.Create;
  771.   FEmail2:=TmsEmailRec.Create;
  772. end;
  773.  
  774. destructor TmsTelecomInfo.Destroy;
  775. begin
  776.   FEmail2.Free;
  777.   FEmail1.Free;
  778.   FPhone3.Free;
  779.   FPhone2.Free;
  780.   FPhone1.Free;
  781.   inherited Destroy;
  782. end;
  783.  
  784. procedure TmsTelecomInfo.SetPhone1(Value : TmsPhoneRec);
  785. begin
  786.   FPhone1.Assign(Value);
  787. end;
  788.  
  789. procedure TmsTelecomInfo.SetPhone2(Value : TmsPhoneRec);
  790. begin
  791.   FPhone2.Assign(Value);
  792. end;
  793.  
  794. procedure TmsTelecomInfo.SetPhone3(Value : TmsPhoneRec);
  795. begin
  796.   FPhone3.Assign(Value);
  797. end;
  798.  
  799. procedure TmsTelecomInfo.SetEmail1(Value : TmsEmailRec);
  800. begin
  801.   FEmail1.Assign(Value);
  802. end;
  803.  
  804. procedure TmsTelecomInfo.SetEmail2(Value : TmsEmailRec);
  805. begin
  806.   FEmail2.Assign(Value);
  807. end;
  808.  
  809. procedure TmsTelecomInfo.Assign(Value : TPersistent);
  810. begin
  811.   if Value is TmsTelecomInfo then
  812.   begin
  813.     FPhone1.Assign((Value as TmsTelecomInfo).FPhone1);
  814.     FPhone2.Assign((Value as TmsTelecomInfo).FPhone2);
  815.     FPhone3.Assign((Value as TmsTelecomInfo).FPhone3);
  816.     FEmail1.Assign((Value as TmsTelecomInfo).FEmail1);
  817.     FEmail2.Assign((Value as TmsTelecomInfo).FEmail2);
  818.   end
  819.   else
  820.     inherited Assign(Value);
  821. end;
  822.  
  823. procedure TmsTelecomInfo.Clear;
  824. begin
  825.   FPhone1.Clear;
  826.   FPhone2.Clear;
  827.   FPhone3.Clear;
  828.   FEmail1.Clear;
  829.   Femail2.Clear;
  830. end;
  831.  
  832. procedure TmsTelecomInfo.SaveToStrings(Strings : TStrings);
  833. begin
  834.   FPhone1.SaveToStrings(Strings);
  835.   FPhone2.SaveToStrings(Strings);
  836.   FPhone3.SaveToStrings(Strings);
  837.   FEmail1.SaveToStrings(Strings);
  838.   FEmail2.SaveToStrings(Strings);
  839. end;
  840.  
  841. procedure TmsTelecomInfo.LoadFromStrings(Strings : TStrings);
  842. begin
  843.   Clear;
  844.   FPhone1.LoadFromStrings(Strings);
  845.   FPhone2.LoadFromStrings(Strings);
  846.   FPhone3.LoadFromStrings(Strings);
  847.   FEmail1.LoadFromStrings(Strings);
  848.   FEmail2.LoadFromStrings(Strings);
  849. end;
  850.  
  851. {TmsCompanyRec}
  852. procedure TmsCompanyRec.Assign(Value : TPersistent);
  853. begin
  854.   if Value is TmsCompanyRec then
  855.   begin
  856.     FName:=(Value as TmsCompanyRec).Name;
  857.     FAUnit:=(Value as TmsCompanyRec).AUnit;
  858.   end
  859.   else
  860.     inherited Assign(Value);
  861. end;
  862.  
  863. procedure TmsCompanyRec.Clear;
  864. begin
  865.   FName:='';
  866.   FAUnit:='';
  867. end;
  868.  
  869. procedure TmsCompanyRec.SaveToStrings(Strings : TStrings);
  870. var
  871.   s : string;
  872. begin
  873.   if Concat(FName, FAUnit)<>'' then
  874.   begin
  875.     s:=Concat('ORG:',FName,';',FAUnit);
  876.     Strings.Add(s);
  877.   end;
  878. end;
  879.  
  880. procedure TmsCompanyRec.LoadFromStrings(Strings : TStrings);
  881. begin
  882.   Clear;
  883.   with TmsPropertyParser.Create do
  884.   try
  885.     Lines:=Strings;
  886.     PropertyName:='ORG';
  887.     Process;
  888.     if Values.Count>1 then
  889.       FAUnit:=Values[1];
  890.     if Values.Count>0 then
  891.       FName:=Values[0];
  892.   finally
  893.     Free;
  894.   end;
  895. end;
  896.  
  897. {TmsBusinessInfo}
  898. constructor TmsBusinessInfo.Create;
  899. begin
  900.   inherited Create;
  901.   FCompany:=TmsCompanyRec.Create;
  902. end;
  903.  
  904. destructor TmsBusinessInfo.Destroy;
  905. begin
  906.   FCompany.Free;
  907.   inherited Destroy;
  908. end;
  909.  
  910. procedure TmsBusinessInfo.SetCompany(Value : TmsCompanyRec);
  911. begin
  912.   FCompany.Assign(Value);
  913. end;
  914.  
  915. procedure TmsBusinessInfo.Assign(Value : TPersistent);
  916. begin
  917.   if Value is TmsBusinessInfo then
  918.   begin
  919.     FTitle:=(Value as TmsBusinessInfo).Title;
  920.     FRole:=(Value as TmsBusinessInfo).Role;
  921.     FCompany.Assign((Value as TmsBusinessInfo).Company);
  922.   end
  923.   else
  924.     inherited Assign(Value);
  925. end;
  926.  
  927. procedure TmsBusinessInfo.Clear;
  928. begin
  929.   FTitle:='';
  930.   FRole:='';
  931.   FCompany.Clear;
  932. end;
  933.  
  934. procedure TmsBusinessInfo.SaveToStrings(Strings : TStrings);
  935. begin
  936.   FCompany.SaveToStrings(Strings);
  937.   if FTitle<>'' then
  938.     Strings.Add(Concat('TITLE:',FTitle));
  939.   if FRole<>'' then
  940.     Strings.Add(Concat('ROLE:',FRole));
  941. end;
  942.  
  943. procedure TmsBusinessInfo.LoadFromStrings(Strings : TStrings);
  944. begin
  945.   Clear;
  946.   FCompany.LoadFromStrings(Strings);
  947.   with TmsPropertyParser.Create do
  948.   try
  949.     Lines:=Strings;
  950.     PropertyName:='TITLE';
  951.     Process;
  952.     if Values.Count<>0 then
  953.       FTitle:=Values[0];
  954.     PropertyName:='ROLE';
  955.     Process;
  956.     if Values.Count<>0 then
  957.       FRole:=Values[0];
  958.   finally
  959.     Free;
  960.   end;
  961. end;
  962.  
  963. {TmsExplanatoryInfo}
  964. constructor TmsExplanatoryInfo.Create;
  965. begin
  966.   inherited Create;
  967.   FComment:=TStringList.Create;
  968. end;
  969.  
  970. destructor TmsExplanatoryInfo.Destroy;
  971. begin
  972.   FComment.Free;
  973.   inherited Destroy;
  974. end;
  975.  
  976. procedure TmsExplanatoryInfo.SetComment(Value : TStrings);
  977. begin
  978.   FComment.Assign(Value);
  979. end;
  980.  
  981. procedure TmsExplanatoryInfo.Assign(Value : TPersistent);
  982. begin
  983.   if Value is TmsExplanatoryInfo then
  984.   begin
  985.     FComment.Assign((Value as TmsExplanatoryInfo).Comment);
  986.     FURL1:=(Value as TmsExplanatoryInfo).URL1;
  987.     FURL2:=(Value as TmsExplanatoryInfo).URL2;
  988.   end
  989.   else
  990.     inherited Assign(Value);
  991. end;
  992.  
  993. procedure TmsExplanatoryInfo.Clear;
  994. begin
  995.   FComment.Clear;
  996.   FURL1:='';
  997.   FURL2:='';
  998. end;
  999.  
  1000. procedure TmsExplanatoryInfo.SaveToStrings(Strings : TStrings);
  1001. var
  1002.   i : Integer;
  1003. begin
  1004.   if FComment.Count>0 then
  1005.   begin
  1006.     FComment[0]:=Concat('NOTE:',FComment[0]);
  1007.     Strings.Add(FComment[0]);
  1008.     for i:=1 to FComment.Count-1 do
  1009.       Strings.Add(Concat('  ',FComment[i]));
  1010.   end;
  1011.   if FURL1<>'' then
  1012.     Strings.Add(Concat('URL:',FURL1));
  1013.   if FURL2<>'' then
  1014.     Strings.Add(Concat('URL:',FURL2));
  1015. end;
  1016.  
  1017. procedure TmsExplanatoryInfo.LoadFromStrings(Strings : TStrings);
  1018. var
  1019.   i : Integer;
  1020. begin
  1021.   Clear;
  1022.   with TmsPropertyParser.Create do
  1023.   try
  1024.     PropertyName:='NOTE';
  1025.     Lines:=Strings;
  1026.     Process;
  1027.     for i:=0 to Values.Count-1 do
  1028.       FComment.Add(Values[i]);
  1029.     PropertyName:='URL';
  1030.     Process;
  1031.     if Values.Count<>0 then
  1032.       FURL1:=Values[0];
  1033.     Process;
  1034.     if Values.Count<>0 then
  1035.       FURL2:=Values[0];
  1036.   finally
  1037.     Free;
  1038.   end;
  1039. end;
  1040.  
  1041. end.
  1042.